home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / getscr_2 / sphere.frm < prev    next >
Text File  |  1999-09-08  |  3KB  |  116 lines
  1. VERSION 5.00
  2. Begin VB.Form Form1 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "Create by Fabiana S. Palacios"
  5.    ClientHeight    =   6900
  6.    ClientLeft      =   45
  7.    ClientTop       =   330
  8.    ClientWidth     =   6840
  9.    DrawStyle       =   5  'Transparent
  10.    FillStyle       =   0  'Solid
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   6900
  15.    ScaleWidth      =   6840
  16.    ShowInTaskbar   =   0   'False
  17.    StartUpPosition =   2  'CenterScreen
  18.    Begin VB.CommandButton Command3 
  19.       Caption         =   "Texture Sphere"
  20.       Height          =   555
  21.       Left            =   2460
  22.       TabIndex        =   2
  23.       Top             =   6300
  24.       Width           =   1995
  25.    End
  26.    Begin VB.CommandButton Command2 
  27.       Caption         =   "Exit"
  28.       Height          =   555
  29.       Left            =   4560
  30.       TabIndex        =   1
  31.       Top             =   6300
  32.       Width           =   2235
  33.    End
  34.    Begin VB.CommandButton Command1 
  35.       Caption         =   "Empty Sphere"
  36.       Height          =   555
  37.       Left            =   120
  38.       TabIndex        =   0
  39.       Top             =   6300
  40.       Width           =   2115
  41.    End
  42. End
  43. Attribute VB_Name = "Form1"
  44. Attribute VB_GlobalNameSpace = False
  45. Attribute VB_Creatable = False
  46. Attribute VB_PredeclaredId = True
  47. Attribute VB_Exposed = False
  48. Dim cX, cY, cR, o
  49.  
  50. Private Sub Command1_Click()
  51.   Call drawEmptySphere
  52. End Sub
  53.  
  54. Private Sub Command2_Click()
  55.   End
  56. End Sub
  57.  
  58. Private Sub Command3_Click()
  59.   Call drawTextureSphere
  60. End Sub
  61.  
  62. Private Sub Form_Load()
  63.   Call cValue
  64. End Sub
  65.  
  66. Public Sub cValue()
  67.   cX = Form1.Width / 2
  68.   cY = Form1.Height / 2
  69.     If cX < cY Then
  70.       cR = cY / 2
  71.     Else
  72.       cR = cX / 2
  73.     End If
  74. End Sub
  75.  
  76. Public Sub drawEmptySphere()
  77.   
  78.   Form1.Refresh
  79.   Form1.DrawStyle = 0
  80.   Form1.FillStyle = 1
  81.   
  82.   o = 1.1
  83.   
  84.   Form1.Line (cX - cR, cY)-(cX + cR, cY)
  85.   For i = 0.1 To 1 Step 0.1
  86.     Form1.Circle (cX, cY), cR, , , , i
  87.   Next i
  88.    
  89.   Form1.Line (cX, cY - cR)-(cX, cY + cR)
  90.   For i = 1 To 3 Step o
  91.      Form1.Circle (cX, cY), cR, , , , o
  92.      o = o * 1.3
  93.      Next i
  94.    For i = 1 To 6 Step o
  95.      Form1.Circle (cX, cY), cR, , , , o
  96.      o = o * 1.8
  97.    Next i
  98. End Sub
  99.  
  100. Public Sub drawTextureSphere()
  101. Dim b%, r%
  102. b = 255
  103. r = 255
  104. Form1.Refresh
  105. Form1.DrawStyle = 5
  106. Form1.FillStyle = 0
  107.  
  108.   For i = 1 To 0.1 Step -0.01
  109.     b = b - 2
  110.     r = r - 2
  111.     Form1.Circle (cX, cY), cR, , , , i
  112.     Form1.FillColor = RGB(r, 0, b)
  113.   Next i
  114.    
  115. End Sub
  116.